indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 352)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.04684 13.04247 13.03820 13.03401 13.02991 13.02589 13.02193 13.01805
## [9] 13.01422 13.01045 13.00673 13.00305 12.99942 12.99582 12.99224 12.98870
## [17] 12.98516 12.98165 12.97814 12.97463 12.97112 12.96760 12.96407 12.96051
## [25] 12.95694 12.95333 12.94969 12.94601 12.94228 12.93852 12.93476 12.93100
## [33] 12.92724 12.92349 12.91975 12.91601 12.91230 12.90860 12.90493 12.90128
## [41] 12.89766 12.89408 12.89053 12.88702 12.88355 12.88012 12.87675 12.87343
## [49] 12.87017 12.86696 12.86382 12.86074 12.85773 12.85480 12.85194 12.84916
## [57] 12.84646 12.84385 12.84132 12.83889 12.83656 12.83433 12.83219 12.83017
## [65] 12.82818 12.82616 12.82411 12.82205 12.81997 12.81788 12.81580 12.81371
## [73] 12.81164 12.80959 12.80756 12.80555 12.80358 12.80165 12.79977 12.79794
## [81] 12.79616 12.79445 12.79282 12.79125 12.78977 12.78838 12.78708 12.78588
## [89] 12.78478 12.78380 12.78293 12.78219 12.78157 12.78109 12.78076 12.78057
## [97] 12.78053 12.78065 12.78094 12.78128 12.78158 12.78185 12.78208 12.78229
## [105] 12.78249 12.78268 12.78286 12.78306 12.78327 12.78350 12.78376 12.78405
## [113] 12.78439 12.78479 12.78524 12.78576 12.78635 12.78702 12.78778 12.78864
## [121] 12.78960 12.79067 12.79186 12.79318 12.79462 12.79621 12.79795 12.79984
## [129] 12.80190 12.80413 12.80653 12.80912 12.81190 12.81588 12.82187 12.82960
## [137] 12.83880 12.84920 12.86053 12.87252 12.88488 12.89736 12.90969 12.92158
## [145] 12.93277 12.94299 12.95196 12.95942 12.96508 12.97117 12.97986 12.99085
## [153] 13.00383 13.01850 13.03455 13.05167 13.06955 13.08791 13.10641 13.12477
## [161] 13.14268 13.15982 13.17590 13.19060 13.20363 13.21467 13.22343 13.22958
## [169] 13.23480 13.24087 13.24771 13.25521 13.26330 13.27186 13.28082 13.29007
## [177] 13.29953 13.30909 13.31867 13.32818 13.33752 13.34659 13.35531 13.36358
## [185] 13.37130 13.37839 13.38475 13.39029 13.39491 13.39853 13.40104 13.40235
## [193] 13.40238 13.40102 13.39819 13.39379 13.38787 13.38059 13.37209 13.36248
## [201] 13.35189 13.34043 13.32823 13.31540 13.30206 13.28833 13.27434 13.26020
## [209] 13.24604 13.23197 13.21811 13.20458 13.18938 13.17065 13.14878 13.12415
## [217] 13.09714 13.06814 13.03751 13.00564 12.97291 12.93971 12.90641 12.87339
## [225] 12.84103 12.80972 12.77983 12.75174 12.72584 12.70250 12.68211 12.66151
## [233] 12.63762 12.61092 12.58189 12.55100 12.51874 12.48558 12.45201 12.41851
## [241] 12.38556 12.35363 12.32320 12.29476 12.26879 12.24576 12.22616 12.20874
## [249] 12.19192 12.17567 12.15995 12.14472 12.12996 12.11562 12.10166 12.08807
## [257] 12.07478 12.06179 12.04904 12.03650 12.02414 12.01191 11.99980 11.98775
## [265] 11.97574 11.96373 11.95271 11.94352 11.93593 11.92967 11.92451 11.92019
## [273] 11.91647 11.91310 11.90984 11.90643 11.90263 11.89819 11.89286 11.88639
## [281] 11.87855 11.86907 11.85891 11.84916 11.83977 11.83071 11.82194 11.81344
## [289] 11.80515 11.79704 11.78909 11.78125 11.77348 11.76575 11.75802 11.75025
## [297] 11.74242 11.73448 11.72640 11.71813 11.70965 11.70123 11.69316 11.68539
## [305] 11.67788 11.67060 11.66350 11.65654 11.64968 11.64288 11.63610 11.62930
## [313] 11.62245 11.61549 11.60839 11.60111 11.59361 11.58602 11.57853 11.57110
## [321] 11.56375 11.55646 11.54923 11.54204 11.53490 11.52779 11.52071 11.51366
## [329] 11.50662 11.49958 11.49255 11.48551 11.47846 11.47139 11.46429 11.45716
## [337] 11.45000 11.44268 11.43515 11.42743 11.41955 11.41154 11.40342 11.39522
## [345] 11.38698 11.37872 11.37047 11.36226 11.35412 11.34608 11.33816 11.33039#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 352)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.63177 12.62686 12.62205 12.61734 12.61273 12.60822 12.60380 12.59948
## [9] 12.59526 12.59113 12.58709 12.58314 12.57929 12.57552 12.57183 12.56823
## [17] 12.56471 12.56128 12.55793 12.55465 12.55145 12.54833 12.54529 12.54232
## [25] 12.53942 12.53659 12.53383 12.53114 12.52852 12.52596 12.52346 12.52103
## [33] 12.51866 12.51635 12.51409 12.51190 12.50975 12.50765 12.50560 12.50360
## [41] 12.50166 12.49977 12.49795 12.49619 12.49450 12.49288 12.49132 12.48985
## [49] 12.48845 12.48713 12.48590 12.48476 12.48370 12.48274 12.48187 12.48110
## [57] 12.48043 12.47986 12.47940 12.47905 12.47882 12.47869 12.47869 12.47881
## [65] 12.47905 12.47942 12.47992 12.48055 12.48131 12.48222 12.48326 12.48446
## [73] 12.48582 12.48733 12.48899 12.49080 12.49275 12.49485 12.49708 12.49945
## [81] 12.50195 12.50457 12.50732 12.51019 12.51318 12.51628 12.51949 12.52280
## [89] 12.52622 12.52974 12.53336 12.53707 12.54086 12.54475 12.54871 12.55276
## [97] 12.55688 12.56107 12.56533 12.56966 12.57405 12.57849 12.58299 12.58755
## [105] 12.59215 12.59679 12.60156 12.60652 12.61166 12.61697 12.62243 12.62803
## [113] 12.63376 12.63961 12.64555 12.65159 12.65770 12.66387 12.67009 12.67635
## [121] 12.68263 12.68892 12.69521 12.70148 12.70771 12.71391 12.72005 12.72612
## [129] 12.73211 12.73800 12.74379 12.74945 12.75498 12.76128 12.76914 12.77834
## [137] 12.78866 12.79988 12.81177 12.82413 12.83673 12.84936 12.86178 12.87380
## [145] 12.88518 12.89572 12.90518 12.91335 12.92002 12.92752 12.93812 12.95143
## [153] 12.96710 12.98477 13.00406 13.02461 13.04606 13.06804 13.09018 13.11212
## [161] 13.13349 13.15393 13.17307 13.19055 13.20600 13.21905 13.22935 13.23652
## [169] 13.24236 13.24887 13.25596 13.26354 13.27153 13.27984 13.28838 13.29706
## [177] 13.30580 13.31451 13.32310 13.33149 13.33959 13.34732 13.35457 13.36128
## [185] 13.36735 13.37270 13.37723 13.38086 13.38351 13.38509 13.38550 13.38467
## [193] 13.38251 13.37892 13.37383 13.36714 13.35782 13.34515 13.32955 13.31142
## [201] 13.29117 13.26921 13.24595 13.22179 13.19716 13.17245 13.14807 13.12444
## [209] 13.10197 13.08105 13.06210 13.04554 13.02829 13.00732 12.98305 12.95592
## [217] 12.92635 12.89477 12.86160 12.82729 12.79225 12.75693 12.72173 12.68710
## [225] 12.65347 12.62126 12.59090 12.56282 12.53745 12.51522 12.49656 12.47878
## [233] 12.45913 12.43790 12.41538 12.39188 12.36769 12.34310 12.31841 12.29392
## [241] 12.26993 12.24673 12.22462 12.20390 12.18485 12.16779 12.15300 12.14015
## [249] 12.12862 12.11831 12.10909 12.10085 12.09347 12.08683 12.08083 12.07534
## [257] 12.07025 12.06544 12.06079 12.05620 12.05154 12.04670 12.04156 12.03600
## [265] 12.02992 12.02319 12.01780 12.01550 12.01583 12.01836 12.02261 12.02813
## [273] 12.03448 12.04119 12.04781 12.05388 12.05896 12.06257 12.06428 12.06363
## [281] 12.06015 12.05341 12.04526 12.03781 12.03096 12.02460 12.01863 12.01294
## [289] 12.00742 12.00197 11.99649 11.99087 11.98500 11.97878 11.97209 11.96485
## [297] 11.95694 11.94825 11.93868 11.92812 11.91648 11.90439 11.89254 11.88085
## [305] 11.86925 11.85768 11.84606 11.83432 11.82239 11.81021 11.79769 11.78478
## [313] 11.77139 11.75746 11.74293 11.72771 11.71174 11.69525 11.67854 11.66159
## [321] 11.64439 11.62693 11.60920 11.59119 11.57288 11.55428 11.53537 11.51614
## [329] 11.49657 11.47667 11.45642 11.43580 11.41482 11.39345 11.37169 11.34954
## [337] 11.32697 11.30380 11.27988 11.25526 11.23000 11.20413 11.17772 11.15081
## [345] 11.12345 11.09570 11.06761 11.03922 11.01059 10.98177 10.95281 10.92376#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 352)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 12.05165 12.04534 12.03917 12.03313 12.02723 12.02144 12.01577 12.01021
## [9] 12.00476 11.99942 11.99417 11.98901 11.98394 11.97895 11.97404 11.96920
## [17] 11.96443 11.95972 11.95507 11.95047 11.94592 11.94141 11.93694 11.93250
## [25] 11.92808 11.92370 11.91932 11.91496 11.91061 11.90626 11.90191 11.89755
## [33] 11.89318 11.88878 11.88437 11.87993 11.87550 11.87110 11.86675 11.86245
## [41] 11.85820 11.85401 11.84987 11.84579 11.84179 11.83784 11.83398 11.83018
## [49] 11.82647 11.82284 11.81929 11.81583 11.81247 11.80920 11.80603 11.80296
## [57] 11.80000 11.79715 11.79441 11.79178 11.78928 11.78690 11.78464 11.78252
## [65] 11.78053 11.77867 11.77696 11.77538 11.77396 11.77268 11.77156 11.77045
## [73] 11.76922 11.76787 11.76643 11.76491 11.76333 11.76169 11.76002 11.75833
## [81] 11.75663 11.75493 11.75326 11.75163 11.75005 11.74853 11.74710 11.74576
## [89] 11.74453 11.74342 11.74246 11.74165 11.74101 11.74055 11.74029 11.74024
## [97] 11.74042 11.74085 11.74153 11.74248 11.74371 11.74525 11.74710 11.74929
## [105] 11.75181 11.75470 11.75787 11.76124 11.76481 11.76858 11.77255 11.77672
## [113] 11.78110 11.78569 11.79048 11.79547 11.80068 11.80609 11.81171 11.81755
## [121] 11.82359 11.82985 11.83632 11.84301 11.84991 11.85703 11.86437 11.87192
## [129] 11.87970 11.88770 11.89592 11.90436 11.91302 11.92353 11.93721 11.95364
## [137] 11.97240 11.99307 12.01522 12.03843 12.06228 12.08635 12.11022 12.13346
## [145] 12.15564 12.17636 12.19518 12.21169 12.22545 12.23983 12.25814 12.27992
## [153] 12.30471 12.33203 12.36144 12.39245 12.42462 12.45747 12.49055 12.52338
## [161] 12.55551 12.58647 12.61579 12.64302 12.66769 12.68933 12.70748 12.72168
## [169] 12.73420 12.74756 12.76165 12.77635 12.79156 12.80716 12.82305 12.83911
## [177] 12.85523 12.87130 12.88721 12.90285 12.91811 12.93287 12.94703 12.96048
## [185] 12.97311 12.98479 12.99543 13.00492 13.01313 13.01997 13.02532 13.02906
## [193] 13.03110 13.03131 13.02959 13.02583 13.01913 13.00895 12.99570 12.97980
## [201] 12.96165 12.94167 12.92026 12.89783 12.87481 12.85159 12.82859 12.80622
## [209] 12.78489 12.76502 12.74700 12.73126 12.71443 12.69322 12.66811 12.63961
## [217] 12.60820 12.57438 12.53866 12.50151 12.46345 12.42496 12.38654 12.34869
## [225] 12.31189 12.27665 12.24347 12.21282 12.18522 12.16116 12.14113 12.12225
## [233] 12.10148 12.07912 12.05544 12.03073 12.00529 11.97938 11.95329 11.92731
## [241] 11.90173 11.87683 11.85288 11.83019 11.80902 11.78967 11.77242 11.75677
## [249] 11.74197 11.72795 11.71464 11.70197 11.68986 11.67825 11.66706 11.65622
## [257] 11.64566 11.63530 11.62508 11.61492 11.60475 11.59450 11.58410 11.57347
## [265] 11.56254 11.55124 11.54048 11.53109 11.52287 11.51564 11.50922 11.50342
## [273] 11.49805 11.49294 11.48788 11.48270 11.47722 11.47124 11.46457 11.45705
## [281] 11.44846 11.43865 11.42826 11.41809 11.40812 11.39835 11.38876 11.37935
## [289] 11.37009 11.36099 11.35202 11.34318 11.33446 11.32584 11.31731 11.30887
## [297] 11.30050 11.29218 11.28392 11.27570 11.26750 11.25951 11.25190 11.24462
## [305] 11.23764 11.23092 11.22441 11.21808 11.21188 11.20577 11.19972 11.19368
## [313] 11.18762 11.18149 11.17525 11.16886 11.16229 11.15568 11.14919 11.14282
## [321] 11.13657 11.13042 11.12436 11.11839 11.11251 11.10669 11.10094 11.09524
## [329] 11.08959 11.08398 11.07841 11.07285 11.06731 11.06178 11.05625 11.05071
## [337] 11.04516 11.03951 11.03372 11.02780 11.02179 11.01571 11.00958 11.00343
## [345] 10.99728 10.99115 10.98508 10.97908 10.97317 10.96739 10.96176 10.95630#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")